functor Codegen (S : CODEGEN_STRUCTS) : CODEGEN =
struct
  open S
  val localDebug = ref false
  structure F = Frame

  structure Asm = F.Assem
  structure E = Env()
  structure M = Mir(structure Ir = F.Ir)
  structure Ctrl = Control
  structure I2M = Ir2Mir(structure Frame = F
                         structure Env = E
                         structure Mir = M)
  structure M2A = Mir2Asm(structure Mir = M
                          structure Frame = F
                          structure Env = E)
  structure D = DebugPrint

  val C_env : (Asm.aptr * Asm.aptr * Asm.etype) list ref = ref []
  fun set_env env = C_env := env

  val C_senv : (string * (int * Asm.etype) list) list ref = ref []
  fun set_senv senv = C_senv := senv
  fun senvInf pos = 
      let fun fdFn pos (inf::r) = if pos = 3
				  then inf
				  else fdFn (pos-1) r
	    | fdFn pos [] = raise Fail "bug\n"
      in fdFn pos (!C_senv)
      end
  fun senvUtil str = 
      let fun fdFn pos ((sname, inf)::r) = if sname = str
					   then (pos, inf)
					   else fdFn (pos+1) r
	    | fdFn pos [] = raise Fail ("the information about "^str^" is NOT found\n")
      in fdFn 3 (!C_senv)
      end

  fun addonAsst addon offset LorS = 
      let fun fdTp ofst = 
	      let fun fdTp' i1 ((Asm.Pstk(of1, Asm.Ebp), d1, tp)::r) = if of1= i1
								     then tp
								     else fdTp' i1 r
		    | fdTp' i1 (i2::r) = fdTp' i1 r
		    | fdTp' i1 [] = raise Fail "fail to find the type\n"

		  val env = !C_env
	      in fdTp' ofst env
	      end

	  val tp = fdTp offset
	  fun exAddon i1 ((i2, inf)::r) = if i1 = i2
					  then (SOME(inf), r)
					  else (#1(exAddon i1 r), (i2, inf)::(#2(exAddon i1 r)))
	    | exAddon i1 [] = (NONE, [])
	  fun hdLoad ofst oftp = 
	      let val oftp' = (fn Asm.Int => 2
				| (Asm.Ptr(Asm.Str(str))) => #1(senvUtil str)
				| _ => 1000) oftp
		  val (r1, r2) = exAddon ofst addon 
	      in (fn NONE => (ofst, oftp')::r2
		   | SOME(t) => if t > oftp'
				then (ofst, t)::r2
				else (ofst, oftp')::r2
		 ) r1
	      end

	  fun hdStore ofst oftp = 
	      let val oftp' = (fn Asm.Int => 1 
				| (Asm.Ptr(Asm.Str(str))) => 1
				| _ => 1000) oftp
		  val (r1, r2) = exAddon ofst addon
	      in (fn NONE => (ofst, oftp')::r2
		   | SOME(t) => if t > oftp'
				then (ofst, oftp')::r2
				else (ofst, t)::r2
		 ) r1
	      end
      in if LorS
	 then (hdLoad offset tp)
	 else (hdStore offset tp)
      end

  fun genBKAsst bk addonI = 
      let val codes = Asm.getCbCode bk

	  fun mpInstr (instr, addon) = 
	      case instr
	       of (Asm.Addm(imm, r1, r2)) => (fn Asm.Ebp => addonAsst addon imm true
					      | _ => addon) r1
		| (Asm.Subm(imm, r1, r2)) => (fn Asm.Ebp => addonAsst addon imm true
					      | _ => addon) r1
		| (Asm.Mulm(imm, r1, r2)) => (fn Asm.Ebp => addonAsst addon imm true
					      | _ => addon) r1
		| (Asm.Movld(imm, r1, r2)) => (fn Asm.Ebp => addonAsst addon imm true
					      | _ => addon) r1
		| (Asm.Movst(r1, imm, r2)) => (fn Asm.Ebp => addonAsst addon imm false
					      | _ => addon) r2
		| _ => addon
      in List.foldr mpInstr addonI codes
      end

  fun genBKsAsst bks = 
      let 
	  fun lastInstr bk = 
	      let val cds = Asm.getCbCode bk
		  val lastI = (fn [] => raise Fail "codes is empty!"
				| t => (List.hd(List.rev(t)))) cds
	      in lastI
	      end
	  fun bkSucc bk  = 
	      let val lastI = lastInstr bk
		  val bklb = Asm.getCbLab bk
	      in (fn Asm.Ret(lb) => []
		   | Asm.Jg(lb1, lb2) => [(bklb, lb1), (bklb, lb2)]
		   | Asm.Je(lb1, lb2) => [(bklb, lb1), (bklb, lb2)]
		   | Asm.Jge(lb1, lb2) => [(bklb, lb1), (bklb, lb2)]
		   | Asm.Jmp(lb) => [(bklb, lb)]
		   | Asm.Call(lb1, lb2) => [(bklb, lb2)] 
		   | Asm.Malloc(sz, lb, tp) => [(bklb, lb)]
		   | _ => raise Fail "bug\n") lastI
	      end

	  val bkCfg = List.concat(List.map bkSucc bks)
	  fun fdDom (iLab, oLab) = 
	      let fun fdCfg lb ((lb1, lb2), r1) = if lb1 = lb
						  then (fn NONE => hdSucc(lb2)
							 | _  => r1) r1
						  else r1
		  and hdSucc lb = if lb = iLab
				  then SOME(true)
				  else (if lb = oLab
					then SOME(false)
					else List.foldl (fdCfg lb) NONE bkCfg
				       )

		  val res = List.foldl (fdCfg oLab) NONE bkCfg
	      in res
	      end

	  fun bkReq bk = 
	      let val lastI = lastInstr bk
		  fun exDLine str = if String.sub (str, 2) = #"_"
				    then true
				    else false 
		  val bklb = Asm.getCbLab bk
	      in (fn Asm.Ret(lb) => []
		   | Asm.Jg(lb1, lb2) => [lb1, lb2]
		   | Asm.Je(lb1, lb2) => [lb1, lb2]
		   | Asm.Jge(lb1, lb2) => [lb1, lb2]
		   | Asm.Jmp(lb) => if exDLine lb
				    then (let val res = fdDom (bklb, lb)
					  in (fn SOME(true) => []
					       | SOME(false) => [lb]
					       | _ => [lb]
					     ) res
					  end 
					 )
				    else [lb]
		   | Asm.Call(lb1, lb2) => [lb2] 
		   | Asm.Malloc(sz, lb, tp) => [lb]
		   | _ => raise Fail "bug\n") lastI
	      end

	  fun hdReq adlist rqs = 
	      let fun exAddon i1 ((i2, it)::r) = if i1 = i2
						 then SOME(it)
						 else exAddon i1 r
		    | exAddon i1 [] = NONE

		  fun mglists (t1', t2') = 
		      let fun mgfdFn clist ((a1, b1), (r1, r2)) = 
			      let val exA1 = exAddon a1 clist
			      in (fn NONE => ((a1, b1)::r1, r2)  
				   | SOME(r) => if r > b1  
						then (r1, (a1, r)::r2)
						else (r1, (a1, b1)::r2)
				 ) exA1
			      end
			  val (res1, res2) = List.foldl (mgfdFn t2') ([], []) t1'
			  val (res3, res4) = List.foldl (mgfdFn t1') ([], []) t2'
		      in res1@res2@res3
		      end

		  fun fdFn (rq1, addon) = 
		      case addon
		       of NONE => NONE
			| SOME(t) => let val r1 = exAddon rq1 adlist
				     in (fn NONE => NONE
					  | SOME(t') => SOME(mglists (t, t'))
					) r1
				     end

		  val _ = (fn [] => raise Fail "rqs is empty!"
			    | _ => ())

		  val init = exAddon (List.hd rqs) adlist
	      in List.foldl fdFn init (List.tl rqs)
	      end

	  fun hdBks (bklist, adlist) = 
	      (fn [] => ([], adlist)
		| tbks => let val hder = List.hd(tbks)
			      val hdlb = Asm.getCbLab hder
			      val hdrq = bkReq hder
			  in case hdrq
			      of [] => let val naddon = genBKAsst hder []
				       in (List.tl(tbks), (hdlb, naddon)::adlist)
				       end
			       | trqs => let val postRq = hdReq adlist hdrq
					 in (fn NONE => (List.tl(tbks)@[hder], adlist)
					      | SOME(t) => let val naddon = genBKAsst hder t
							   in (List.tl(tbks), (hdlb, naddon)::adlist)
							   end
					    ) postRq
					 end
			  end
	      ) bklist

	  fun hdBksTop (bklist, adlist) = 
	      case bklist
	       of [] => adlist
		| _ => let val newInf = hdBks (bklist, adlist)
		       in hdBksTop newInf
		       end
      in hdBksTop (bks, [])
      end

  fun dboutAddon addon  = 
      let fun inf2str ((i1, i2), str') = Int.toString(i1)^" : P("^
					 Int.toString(i2)^")\n"^str'
	  fun one_addon (bklab, inf) = bklab^"\n("^(List.foldr inf2str "" inf)^")\n\n"
	  val addonstr = String.concat(List.map one_addon addon)
      in print addonstr
      end

  fun genAsst frlist senv = 
      let val _ = set_senv senv
	  fun fdFrFn fr = 
	      let val _ = (fn NONE => raise Fail "no env!\n"
			    | SOME(e) => set_env(e)) (F.getEnv fr)
		  val cdbks = (fn NONE => raise Fail "no codeblocks!\n"
				| SOME(c) => c) (F.getCode fr)
		  val addon = genBKsAsst cdbks

		  val frName = F.getFname fr
		  val frPre = ref (F.getPreA fr)

		  fun fdFirst (cd, res) = 
		      (fn NONE => if frName = (Asm.getCbLab(cd))
				  then (let val _ = (fn [] => raise Fail "bug\n"
						      | _ => ()) (Asm.getCbCode(cd))
					    val lastI = List.hd(List.rev(Asm.getCbCode(cd)))
					in (fn Asm.Jmp(l) => SOME(l)
					     | _ => raise Fail "bug\n") lastI
					end)
				  else NONE
			| SOME(t) => SOME(t)) res
		  val frFirst = (fn NONE => raise Fail "bug\n"
				  | SOME(t) => t) (List.foldl fdFirst NONE cdbks)

		  (* modify each code block *)
		  fun modBK adlist bk = 
		      let val bkasst = Asm.getCbAsst bk
			  val bkname = Asm.getCbLab bk

			  fun fdasst i1 ((i2, t)::r) = if i1 = i2
						       then SOME(t)
						       else fdasst i1 r
			    | fdasst i1 [] = NONE
			  val new_asst1 = (fn NONE => raise Fail "bug: cannot find new assert\n"
					    | SOME(t) => t) (fdasst bkname adlist)
			  val new_asst = if frName = bkname orelse frFirst = bkname
					 then (List.concat (List.map (fn (i, t) => if i > 0
										   then [(i, t)]
										   else []) new_asst1))
					 else new_asst1

			  fun tp2prop sofst iORo (sname, sinf) = 
			      let fun fdFn ((ofst, tp), (r1, r2)) = 
				      let val (ofst1, tp') = r1
					  val r1' = if ofst > ofst1
						    then (ofst, tp)
						    else r1
					  val r2' = if tp = Asm.Ptr(Asm.Str(sname))
						    then (ofst::r2)
						    else r2
				      in (r1', r2')
				      end
				  val ((mofst, mtp), inf2) = List.foldl fdFn ((~1, Asm.Int), []) sinf
				  val sz' = (fn Asm.Int => 4
					      | Asm.Ptr(tp) => 4
					      | _ => raise Fail "not yet") mtp
				  val sz = Int.div((mofst + sz'), 4)
			      in (fn 1 => if iORo
					  then (fn s0 =>
						fn s => Asm.List(Asm.getHp(s)
							       , Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Esp))
									, Asm.IntNum(sofst-4))
							       , sz
							       , (List.hd(inf2))))
					  else (fn s0 =>
						fn s => Asm.List(Asm.getHp(s)
							       , Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Ebp))
									, Asm.IntNum(sofst))
							       , sz
							       , (List.hd(inf2))))
				   | 2 => if iORo 
					  then (fn s0 => 
						fn s => Asm.Tree(Asm.getHp(s)
							       , Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Esp))
									, Asm.IntNum(sofst-4))
							       , sz
							       , (List.hd(inf2))
							       , (List.hd(List.rev(inf2)))))
					  else (fn s0 => 
						fn s => Asm.Tree(Asm.getHp(s)
							       , Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Ebp))
									, Asm.IntNum(sofst))
							       , sz
							       , (List.hd(inf2))
							       , (List.hd(List.rev(inf2)))))
				   | _ => (fn s0 =>
					   fn s => Asm.True)
				 ) (List.length inf2)
			      end

			  fun tr_addon (ofst, ptp) iORo =
			      case ptp
			       of 1 => if iORo
				       then (fn s0 =>
					     fn s => Asm.InDomM(s, Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Esp))
									  , Asm.IntNum(ofst-4))))
				       else (fn s0 =>
					     fn s => Asm.InDomM(s, Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Ebp))
									  , Asm.IntNum(ofst))))
				| 2 => if iORo 
				       then (fn s0 =>
					     fn s => Asm.Ex(("sv", Asm.Int), 
							    Asm.Eq(Asm.Sel(Asm.getHp(s), 
									   Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Esp))
										  , Asm.IntNum(ofst-4)))
								 , Asm.Id("sv"))))
				       else (fn s0 =>
					     fn s => Asm.Ex(("sv", Asm.Int), 
							    Asm.Eq(Asm.Sel(Asm.getHp(s), 
									   Asm.Plus(Asm.Sel(Asm.getRf(s), Asm.Reg(Asm.Ebp))
										  , Asm.IntNum(ofst)))
								 , Asm.Id("sv"))))
				| _ => (let val tpinf = senvInf ptp
					in tp2prop ofst iORo tpinf
					end)

			  fun tr_addon' adlist iORo = 
			      case adlist
			       of [] => (fn s0 =>
					 fn s => Asm.True)
				| _ => let val hd = List.hd adlist
					   fun asstAnd a1 a2 = (fn s0 =>
								fn s => Asm.And((a1 s0 s)
									      , (a2 s0 s)))
				       in List.foldr (fn (t, t1) => (asstAnd (tr_addon t iORo) t1))
						     (tr_addon hd iORo) (List.tl adlist)
				       end

		      in (fn NONE => bk
			   | SOME(t) => 
			     let val new_asst' = if frName = bkname 
						 then (tr_addon' new_asst true) 
						 else (tr_addon' new_asst false)
				 val _ = if frName = bkname 
					 then frPre := SOME(new_asst')
					 else ()
			     in Asm.setCbAsst (bk, new_asst')
			     end
     			 ) bkasst
		      end
		  val new_cdbks = List.map (modBK addon) cdbks

		  val n_fr = F.setCode (fr, new_cdbks)
		  val n_pre = (fn NONE => NONE
				| SOME(t) => SOME(t, NONE)) (!frPre)
	      in F.setPre(n_fr, n_pre)
	      end
      in (List.map fdFrFn frlist)
      end

  fun ir2framel ir =
      let val a = I2M.emitCode ir false
          val (framelist, senv, data) = M2A.emitCode' a
          val bogusAsst : Asm.assert = fn s0 =>
                                       fn s => Asm.True
          fun delCodeA cb =
              case (Asm.getCbAsst cb)
               of NONE => cb
                | SOME a => Asm.setCbAsst (cb, bogusAsst)

          fun delFrameA fr =
              let val codelist = 
                      case (F.getCode fr)
                       of NONE => raise Fail "no code"
                        | SOME c => c
                  val newCodelist = List.map delCodeA codelist
                  val fr1 = F.setPre (fr, SOME (bogusAsst, NONE))
                  val fr2 = F.setPost (fr1, SOME (bogusAsst, NONE))
                  val fr3 = F.setCode (fr2, newCodelist)
              in  fr3
              end
          val newFrList = List.map delFrameA framelist
	  val newFrList' = genAsst newFrList senv
      in  (newFrList', data)
      end

  val nNot = ref 4 
  fun newNotat () = 
      let val t = !nNot
	  val _ = nNot := (!nNot) + 1
      in t
      end

  fun rebdChs (cdp, ginf) = 
      let val _ = nNot := 4 
	  fun cd4pFn cd4p = 
	      let val clab = Asm.getCbLab4p cd4p
		  val cds = Asm.getCbCode4p cd4p
		  val nid = newNotat ()
	      in Asm.setCb(clab, nid, cds, NONE, NONE, [])
	      end

	  fun pprfFn pprf = 
	      let val fname = Asm.getFname pprf
		  val cdbks = List.map cd4pFn (Asm.getCode pprf)
		  val tmpfr = F.newFrame fname 0 (F.Ir.Int)
	      in F.setCode (tmpfr, cdbks)
	      end

	  val tmpFrl = List.map pprfFn cdp

	  fun newdata data = Asm.getData ginf
      in (tmpFrl, (newdata ginf))
      end

  fun ir2pprf ir = 
      let val a = I2M.emitCode ir false
          val (framel, senv, data) = M2A.emitCode' a

	  fun bdFRets frame = 
	      let val fname = F.getFname frame
		  val frettp = F.getRetType frame
		  fun rettp' tp = 
		      case tp
		       of (F.Ir.Int) => Asm.Int
			| (F.Ir.Bool) => Asm.Int
			| (F.Ir.Void) => Asm.Wild
			| (F.Ir.Pointer t) => Asm.Ptr(rettp' t)
			| (F.Ir.Struct str) => Asm.Str(str)
			| _ => Asm.Wild
	      in (fname, (rettp' frettp))
	      end

          fun gprf frame = 
              let val fname = F.getFname frame
                  fun getpa (aopt: (Asm.assert * Asm.passert) option) = 
                      (case aopt
                        of  NONE => NONE
                          | SOME a => #2 a)
                  val p = getpa (F.getPre frame)
                  val q = getpa (F.getPost frame)
                  fun debugPrintPa paopt =
                      let val pa2str =
                              (case paopt 
                                of  NONE => "NONE"
                                  | SOME pa => Asm.pprop2str pa)
                      in  D.debugPrint("Passert : "^ pa2str)
                      end
                  fun cb2cb4ptr cb =
                      let val lab = Asm.getCbLab cb
                          fun filtCode4p [] = []
                            | filtCode4p (i :: is) =
                              (case i
                                of  Asm.ExtrA _ => filtCode4p is
                                  | _ => i :: (filtCode4p is))
                          val code = filtCode4p (Asm.getCbCode cb) 
                          val pa = Asm.getCbPasst cb
                          val _ = if !localDebug 
                                  then debugPrintPa pa
                                  else ()
                      in  Asm.setCb4p (lab, code, pa)
                      end
                  val code = (case F.getCode frame
                               of  NONE => []
                                 | SOME c => List.map cb2cb4ptr c)
                  val env = (case (F.getEnv frame)
                              of  NONE => []
                                | SOME e => e)
              in  Asm.setPprf (fname, p, q, code, env)
              end
      in  (List.map gprf framel, Asm.setGinf (senv, data, (List.map bdFRets framel)))
      end

  fun ir2code ir =
      let val a = I2M.emitCode ir false
          val _ = M2A.tmp_out a
      in ()
      end 
end
